home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / setext.tcl < prev    next >
Text File  |  1995-02-23  |  1KB  |  45 lines

  1. #################################################################################
  2. # Setext file support
  3. #
  4. # Recognize and automatically mark 'setext'-encoded text files, like Tidbits.
  5. #
  6. # (Tom Pollard - October 1994)
  7. #
  8. #================================================================================
  9. lappend modes Setx
  10. set modeMenus(Setx)                { }
  11. lappend modeSuffixes            {*.stx} { set winMode Setx }
  12. lappend modeSuffixes            {*.etx} { set winMode Setx }
  13. set dummyProc(Setx)                dummySetx
  14. newModeVar Setx autoMark    1    1
  15. #=============================================================================
  16. proc dummySetx {} {}
  17.  
  18. proc SetxMarkFile {} {
  19.     set pat1 {^(-+|=+)$}
  20.     set end [maxPos]
  21.     set pos 0
  22.     set l {}
  23.     while {![catch {search -f 1 -r 1 -m 0 -i 1 $pat1 $pos} mtch]} {
  24.         set pos1 [lineStart [expr [lindex $mtch 0] - 1]]
  25.         set marker [string trimright [eval getText $mtch]]
  26.         set text [string trimright [getText $pos1 [nextLineStart $pos1]]]
  27.         if {[string length $text] == [string length $marker]} {
  28.             if {[string range $marker 0 0] == "-"} {
  29.                 set text "     $text"
  30.             }
  31.             regsub {/} $text {-} text
  32.             set inds($text) $pos1
  33.             lappend sects $text
  34.         }
  35.         set pos [nextLineStart [lindex $mtch 1]]
  36.     }
  37.  
  38.     if {[info exists inds]} {
  39.         foreach f $sects {
  40.             set next [lineStart $inds($f)]
  41.             setNamedMark $f $inds($f) $next $next
  42.         }
  43.     }
  44. }
  45.